Unit BTreeObjectUnit;

{$mode objfpc}{$H+}{$interfaces CORBA}

Interface

Uses
  Classes, SysUtils, BCommonUnit, BObjectUnit, BListsUnit, BQueryUnit;

Type

{ BTreeObject }

Generic BTreeObject<BManagedClass> = Class(BObjectClass)
  Type BManagedList = Specialize BList<BManagedClass>;
  Type IManagedInterface = Specialize IGenericInterface<BManagedClass>;
  Type BManagedLinkedThreadList = Specialize BLinkedThreadList<BManagedClass>;
  Private
    bFirstChild: BManagedClass;
    bLastChild: BManagedClass;
    bParentID, bNextID, bPriorID: Integer;

    Function GetChildren: BManagedList;
    Function GetFirstChild: BManagedClass;
    Function GetLastChild: BManagedClass;
    Function GetLevel: Integer;
    Procedure Assign(Const aObject: BManagedClass);
    Procedure SetParent(aValue: BManagedClass);
  Protected
    bParent: BManagedClass;
    bNext, bPrior: BManagedClass;
    bChildren: BManagedLinkedThreadList;
  Public
    Property Next: BManagedClass Read bNext Write bNext;
    Property Prior: BManagedClass Read bPrior Write bPrior;
    Property Parent: BManagedClass Read bParent Write SetParent;

    Property FirstChild: BManagedClass Read bFirstChild Write bFirstChild;
    Property LastChild: BManagedClass Read bLastChild Write bLastChild;
    Property Level: Integer Read GetLevel;

    Property Children: BManagedList Read GetChildren;

    Constructor Build(Const aID: Integer);
    Destructor Burn; Virtual;
End;

Type BRequestKind = (rkNext = 1, rkPrior = 2 , rkFirst = 3, rkLast = 4);

Type

{ BBehaviorGeneric }

BBehaviorClass = Class
  Private
    bKind: BRequestKind;
    bTarget: TObject;
    bValue: TObject;
  Public
    Property Target: TObject Read bTarget;
    Property Kind: BRequestKind Read bKind;
    Property Value: TObject Read bValue Write bValue;
    Constructor Build(Const aTarget: TObject; Const aRequestKind: BRequestKind);
    Destructor Burn;
End;

Type BBehaviorsList = Specialize BPrimitiveList<BBehaviorClass>;

//Type Generic BTreeManagerGeneric<BManagedClass> = Class;

Type

{ BRequestHandlerGeneric }

Generic BRequestHandlerGeneric<BManagedClass> = Class
  Private
    bBehaviors: BBehaviorsList;
    bFirst, bLast: BManagedClass;
    Function GetBehavior(Const aTarget: BManagedClass;
      Const aKind: BRequestKind): BBehaviorClass;
  Public
    //** First element for manager. Need update
    Property First: BManagedClass Read bFirst Write bFirst;
    //** Last element for manager. Need update
    Property Last: BManagedClass Read bLast Write bLast;
    //**
    Property Behaviors: BBehaviorsList Read bBehaviors;

    //** Set or Change Behavior of Target on request
    Procedure SetBehavior(Const aTarget: BManagedClass;
      Const aKind: BRequestKind; Const aValue: BManagedClass);
    //** Return value of Target based on behavior
    Function GetValue(Const aTarget: BManagedClass;
      Const aKind: BRequestKind): BManagedClass;

    //** Removes any behaviors and last and first
    Procedure Purge;
    //** Removes any behaviors
    Procedure Rollback;

    Constructor Build(Const aFirst, aLast: BManagedClass);
    Destructor Burn;
End;

Type

{ BTreeManagerGeneric }

Generic BTreeManagerGeneric<BManagedClass> = Class
  Type BRequestHandlerClass = Specialize BRequestHandlerGeneric<BManagedClass>;

  Type BManagerClass = Specialize BManagerGeneric<BManagedClass>;

  Type BManagedList = Specialize BList<BManagedClass>;
  Type BManagedThreadList = Specialize BThreadList<BManagedClass>;
  Type BManagedLinkedList = Specialize BLinkedList<BManagedClass>;
  Type BManagedLinkedThreadList = Specialize BLinkedThreadList<BManagedClass>;
  Private
    bManager: BManagerClass;
    bRequestHandler: BRequestHandlerClass;
  Protected
    bCommitted: BManagedThreadList;
    bNonCommitted: BManagedThreadList;

    //** First
    bFirst: BManagedClass; Static;

    bLast: BManagedClass; Static;

    //** Add Object with lazy initialization
    Function AddObject(Const aID, aParentID, aPriorID,
      aNextID: Integer): BManagedClass;

    Procedure FindFirstAndLast;

    Procedure FillRelations;

    Procedure OnCloneObject(Const aOriginal, aClone: BManagedClass);
    Procedure OnAssignObject(Const aOriginal, aClone: BManagedClass);
  Public
    //** Flat manager that working with base
    Property Manager: BManagerClass Read bManager;

    //**
    Property Committed: BManagedThreadList Read bCommitted;

    //** Switch state of Manager (e.g. Loading state)
    Procedure EnterState(Const aState: BManagerState);
    //** Return Manager to normal state
    Procedure LeaveState;


    //** Return new Object
    Function AddObject(Const aParent: BManagedClass): BManagedClass; Virtual;
    //** Return Object by ID
    Function GetObject(Const aID: Integer): BManagedClass;
    //** Request Object for change
    Function ChangeObject(Const aObject: BManagedClass): BManagedClass;
    //** Request deletion of Object
    Function DeleteObject(Var aObject: BManagedClass): BManagedClass;
    //** Request for move Object
    Function MoveObject(Const aObject, aNewParent, aNewNext: BManagedClass):
      BManagedClass;


    //** Return Next node for current Node
    Function GetNext(Const aObject: BManagedClass): BManagedClass; Virtual;
    //** Return Prior node
    Function GetPrior(Const aObject: BManagedClass): BManagedClass;  Virtual;
    //** Return First child for not null parent and first node otherwise
    Function GetFirstChild(Const aParent: BManagedClass): BManagedClass;Virtual;
    //** Return Last child for not null parent and last node otherwise
    Function GetLastChild(Const aParent: BManagedClass): BManagedClass; Virtual;

    Procedure Commit; Virtual;
    Procedure Rollback;

    Procedure Purge;

    Constructor Build(Const aCommittedList: BManagedThreadList;
      Const aDBIndex: Integer; Const aTableName: String);
    Destructor Burn; Virtual;
End;

Implementation

{ BBehaviorGeneric }

Constructor BBehaviorClass.Build(Const aTarget: TObject;
  Const aRequestKind: BRequestKind);
Begin
  bTarget := aTarget;
  bKind := aRequestKind;
End;

Destructor BBehaviorClass.Burn;
Begin

End;

{ BRequestHandlerClass }

Function BRequestHandlerGeneric.GetBehavior(Const aTarget: BManagedClass;
  Const aKind: BRequestKind): BBehaviorClass;
Var
  i: Integer;
  aObject: BManagedClass;
Begin
  Result := nil;
  For i := 0 To bBehaviors.Count - 1 Do
    Begin
      If  ((bBehaviors[i].Target = nil) And (aTarget = nil) And
        (bBehaviors[i].Kind = aKind)) Or (Not(bBehaviors[i].Target=nil) And
        (bBehaviors[i].Target.Equals(aTarget)) And (bBehaviors[i].Kind=aKind))Then
        Begin
          Result := bBehaviors[i];
          Break;
        End;

    End;
End;

Procedure BRequestHandlerGeneric.SetBehavior(Const aTarget: BManagedClass;
  Const aKind: BRequestKind; Const aValue: BManagedClass);
Var
  aBehavior: BBehaviorClass;
Begin
  aBehavior := GetBehavior(aTarget, aKind);
  If aBehavior = nil Then
    Begin
      aBehavior := BBehaviorClass.Build(aTarget, aKind);
      bBehaviors.Add(aBehavior);
    End;
  aBehavior.Value := aValue;
End;

Function BRequestHandlerGeneric.GetValue(Const aTarget: BManagedClass;
  Const aKind: BRequestKind): BManagedClass;
Var
  aBehavior: BBehaviorClass;
Begin
  Result := nil;
  aBehavior := GetBehavior(aTarget, aKind);
  If aBehavior = nil Then
    Case aKind Of
      rkFirst:
        If Not(aTarget = nil) Then Result := aTarget.FirstChild
        Else Result := bFirst;
      rkPrior: Result := aTarget.Prior;
      rkNext: Result := aTarget.Next;
      rkLast:
        If Not(aTarget = nil) Then Result := aTarget.LastChild
        Else Result := bLast;
    End
  Else
    //TODO: цикл для множественных изменений
    Result := BManagedClass(aBehavior.Value);
End;

Procedure BRequestHandlerGeneric.Purge;
Begin
  Rollback;
  bLast := nil;
  bFirst := nil;
End;

Procedure BRequestHandlerGeneric.Rollback;
Var
  i: Integer;
Begin
  For i := 0 To bBehaviors.Count - 1 Do
    bBehaviors[i].Burn;
  bBehaviors.Clear;
End;

Constructor BRequestHandlerGeneric.Build(Const aFirst, aLast: BManagedClass);
Begin
  bFirst := aFirst;
  bLast := aLast;
  bBehaviors := BBehaviorsList.Create;
End;

Destructor BRequestHandlerGeneric.Burn;
Begin
  Purge;
  bBehaviors.Free;
End;

{ BTreeManager }

Procedure BTreeManagerGeneric.FillRelations;
Var
  i: Integer;
  aCommitted: BManagedList;
  aChildrenList: BManagedLinkedList;
  aObject, aParent, aPrior, aNext: BManagedClass;
Begin
  Try
    aCommitted := bCommitted.LockList;
    For i := 0 To aCommitted.Count - 1 Do
      Begin
        aObject := aCommitted.GetAt(i);
        aParent := aCommitted.Find(aObject.bParentID);

        If (aParent=nil) And Not(aObject.bParentID=-1) Or aObject.Deleted Then
          Begin
            // Workaround. Next time - remove this node
            aObject.Parent := BManagedClass(Self);
            aObject.bDeleted := TRUE;
            Continue;
          End;

        aPrior := aCommitted.Find(aObject.bPriorID);
        aNext := aCommitted.Find(aObject.bNextID);

        aObject.Parent := aParent;
        aObject.Prior := aPrior;
        aObject.Next := aNext;

        If Not(aPrior = nil) Then aPrior.Next := aObject;
        If Not(aNext = nil) Then aNext.Prior := aObject;

        If Not(aParent = nil) Then
          Begin
            If aPrior = nil Then aParent.FirstChild := aObject;
            If aNext = nil Then aParent.LastChild := aObject;
          End;
      End;
  Finally
    bCommitted.UnlockList;
  End;
  FindFirstAndLast;
End;

Procedure BTreeManagerGeneric.OnCloneObject(Const aOriginal,
  aClone: BManagedClass);
Begin
  // Original is nil when deleted noncommitted object
  If Not((aOriginal = nil) Or (aClone = nil)) Then
    Begin
      aClone.bDeleted := aOriginal.Deleted;


      aClone.Prior := aOriginal.Prior;
      aClone.Next := aOriginal.Next;
      aClone.Parent := aOriginal.Parent;

      aClone.FirstChild := aOriginal.FirstChild;
      aClone.LastChild := aOriginal.LastChild;
    End;
End;

Procedure BTreeManagerGeneric.OnAssignObject(Const aOriginal,
  aClone: BManagedClass);
Begin
  // Original is nil when deleted noncommitted object
  If Not((aOriginal = nil) Or (aClone = nil)) Then
    Begin
      aOriginal.bDeleted := aClone.Deleted;

      aOriginal.Prior := aClone.Prior;
      aOriginal.Next := aClone.Next;
      aOriginal.Parent := aClone.Parent;

      aOriginal.FirstChild := aClone.FirstChild;
      aOriginal.LastChild := aClone.LastChild;
    End;
End;

Procedure BTreeManagerGeneric.EnterState(Const aState: BManagerState);
Begin
  bManager.EnterState(aState);
End;

Procedure BTreeManagerGeneric.LeaveState;
Begin
  If bManager.State = msLoading Then FillRelations;
  bManager.LeaveState;
End;

Function BTreeManagerGeneric.GetObject(Const aID: Integer): BManagedClass;
Begin
  Result := BManagedClass(Manager.GetObject(aID));
End;

Function BTreeManagerGeneric.AddObject(
  Const aParent: BManagedClass): BManagedClass;
Begin
  Result := Manager.AddObject;
  Result.Prior := GetLastChild(aParent);
  Result.Next := nil;
  Result.Parent := aParent;

  bRequestHandler.SetBehavior(aParent, rkLast, Result);
  If Result.Prior = nil Then
    bRequestHandler.SetBehavior(aParent, rkFirst, Result)
  Else
    bRequestHandler.SetBehavior(Result.Prior, rkNext, Result);
End;

Function BTreeManagerGeneric.ChangeObject(
  Const aObject: BManagedClass): BManagedClass;
Begin
  Result := Manager.ChangeObject(aObject);
End;

Function BTreeManagerGeneric.DeleteObject(
  Var aObject: BManagedClass): BManagedClass;
Var
  aPrior, aNext: BManagedClass;
Begin
  Result := Manager.DeleteObject(aObject);
  aPrior := GetPrior(aObject);
  aNext := GetNext(aObject);

  If aPrior = nil Then
    bRequestHandler.SetBehavior(aObject.Parent, rkFirst, aNext)
  Else
    bRequestHandler.SetBehavior(aPrior, rkNext, aNext);

  If aNext = nil Then
    bRequestHandler.SetBehavior(aObject.Parent, rkLast, aPrior)
  Else
    bRequestHandler.SetBehavior(aNext, rkPrior, aPrior);
End;

Function BTreeManagerGeneric.MoveObject(Const aObject, aNewParent,
  aNewNext: BManagedClass): BManagedClass;
Var
  aNewPrior: BManagedClass;
  aOldParent, aOldPrior, aOldNext: BManagedClass;
Begin
  Result := ChangeObject(aObject);
  aOldParent := aObject.Parent;
  aOldPrior := GetPrior(aObject);
  aOldNext := GetNext(aObject);

  If aOldPrior = nil Then
    bRequestHandler.SetBehavior(aOldParent, rkFirst, aOldNext)
  Else
    bRequestHandler.SetBehavior(aOldPrior, rkNext, aOldNext);
  If aOldNext = nil Then
    bRequestHandler.SetBehavior(aOldParent, rkLast, aOldPrior)
  Else
    bRequestHandler.SetBehavior(aOldNext, rkPrior, aOldPrior);

  If Not(aNewNext = nil) Then aNewPrior := GetPrior(aNewNext)
  Else aNewPrior := GetLastChild(aNewParent);

  If aNewPrior = nil Then
    bRequestHandler.SetBehavior(aNewParent, rkFirst, Result)
  Else
    bRequestHandler.SetBehavior(aNewPrior, rkNext, Result);
  If aNewNext = nil Then
    bRequestHandler.SetBehavior(aNewParent, rkLast, Result)
  Else
    bRequestHandler.SetBehavior(aNewNext, rkPrior, Result);

  bRequestHandler.SetBehavior(aObject, rkPrior, aNewPrior);
  bRequestHandler.SetBehavior(aObject, rkNext, aNewNext);

  Result.Parent := aNewParent;
  Result.Next := aNewNext;
  Result.Prior := aNewPrior;
End;

Function BTreeManagerGeneric.AddObject(Const aID, aParentID, aPriorID,
  aNextID: Integer): BManagedClass;
Begin
  Result := Manager.AddObject(aID);
  Result.bParentID := aParentID;
  Result.bPriorID := aPriorID;
  Result.bNextID := aNextID;
End;

Procedure BTreeManagerGeneric.FindFirstAndLast;
Var
  i: Integer;
  aCommitted: BManagedList;
Begin
  Try
    aCommitted := bCommitted.LockList;
    For i := 0 To aCommitted.Count - 1 Do
      If (aCommitted.GetAt(i).Parent = nil) Then
        Begin
          If (aCommitted.GetAt(i).Prior = nil) Then
            Begin
              bFirst := aCommitted.GetAt(i);
              bRequestHandler.First := bFirst;
            End;
          If aCommitted.GetAt(i).Next = nil Then
            Begin
              bLast := aCommitted.GetAt(i);
              bRequestHandler.Last := bLast;
            End;
        End;
  Finally
    bCommitted.UnlockList;
  End;
End;

Function BTreeManagerGeneric.GetNext(
  Const aObject: BManagedClass): BManagedClass;
Begin
  If Not(Manager.Modified) Then Result := aObject.Next
  Else Result := bRequestHandler.GetValue(aObject, rkNext);
End;

Function BTreeManagerGeneric.GetPrior(Const aObject: BManagedClass): BManagedClass;
Begin
  If Not(Manager.Modified) Then Result := aObject.Prior
  Else Result := bRequestHandler.GetValue(aObject, rkPrior);
End;

Function BTreeManagerGeneric.GetFirstChild(
  Const aParent: BManagedClass): BManagedClass;
Begin
  If Not(Manager.Modified) Then
    If Not(aParent = nil) Then Result := aParent.FirstChild
    Else Result := bFirst
  Else
    Result := bRequestHandler.GetValue(aParent, rkFirst)
End;

Function BTreeManagerGeneric.GetLastChild(
  Const aParent: BManagedClass): BManagedClass;
Begin
  If Not(Manager.Modified) Then
    If aParent = nil Then Result := bLast
    Else Result := aParent.LastChild
  Else Result := bRequestHandler.GetValue(aParent, rkLast);
End;

Procedure BTreeManagerGeneric.Commit;
Var
  i: Integer;
  aObject: BManagedClass;
  aBehavior: BBehaviorClass;

  aList: BManagedList;
Begin
  For i := 0 To bRequestHandler.Behaviors.Count - 1 Do
    Begin
      aBehavior := bRequestHandler.Behaviors[i];
      If aBehavior.Target = nil Then Continue;

      aObject := BManagedClass(aBehavior.Target);
      aObject := ChangeObject(aObject);
      Case aBehavior.Kind Of
        rkFirst: aObject.FirstChild := BManagedClass(aBehavior.Value);
        rkLast: aObject.LastChild := BManagedClass(aBehavior.Value);
        rkPrior: aObject.Prior := BManagedClass(aBehavior.Value);
        rkNext: aObject.Next := BManagedClass(aBehavior.Value);
      End;
    End;

  bManager.Commit;

  aList := bCommitted.LockList;
  For i := 0 To aList.Count - 1 Do
    Begin
      aObject := aList.GetAt(i);
      If Not(aObject.FirstChild = nil) And
        Not(aObject.FirstChild.ORMState = ormCommitted) Then
          aObject.FirstChild := aList.Find(aObject.FirstChild.ID);

      If Not(aObject.LastChild = nil) And
        Not(aObject.LastChild.ORMState = ormCommitted) Then
          aObject.LastChild := aList.Find(aObject.LastChild.ID);

      If Not(aObject.Parent = nil) And
        Not(aObject.Parent.ORMState = ormCommitted) Then
          aObject.Parent := aList.Find(aObject.Parent.ID);

      If Not((aObject.Prior = nil) Or
        (aObject.Prior.ORMState = ormCommitted)) Then
          aObject.Prior := aList.Find(aObject.Prior.ID);

      If Not((aObject.Next = nil) Or
        (aObject.Next.ORMState = ormCommitted))Then
          aObject.Next := aList.Find(aObject.Next.ID);
    End;
  bCommitted.UnlockList;

  FindFirstAndLast;
End;

Procedure BTreeManagerGeneric.Rollback;
Var
  i: Integer;
Begin
  bRequestHandler.Rollback;
  Manager.Rollback;
End;

Procedure BTreeManagerGeneric.Purge;
Begin
  bRequestHandler.Purge;
  Manager.Purge;
  bFirst := nil;
  bLast := nil;
End;

Constructor BTreeManagerGeneric.Build(Const aCommittedList: BManagedThreadList;
  Const aDBIndex: Integer; Const aTableName: String);
Begin
  bManager := BManagerClass.Build(aCommittedList, aDBIndex, aTableName);
  bManager.OnClone := @OnCloneObject;
  bManager.OnAssign := @OnAssignObject;
  //bManager.OnCommit := @OnCommitObject;

  bCommitted := bManager.Committed;
  bNonCommitted := bManager.NonCommitted;

  bRequestHandler := BRequestHandlerClass.Build(bFirst, bLast);;
End;

Destructor BTreeManagerGeneric.Burn;
Begin
  bRequestHandler.Burn;
  bManager.Burn;
End;

{ BTreeObject }

Procedure BTreeObject.SetParent(aValue: BManagedClass);
Begin
  bParent:=aValue;
End;

Constructor BTreeObject.Build(Const aID: Integer);
Begin
  bPrior := nil;
  bNext := nil;
  bID := aID;
  bChildren := BManagedLinkedThreadList.Build;
End;

Destructor BTreeObject.Burn;
Begin
  bChildren.Burn;
End;

Function BTreeObject.GetLevel: Integer;
Begin
  Result := -1;
  If Parent = nil Then Result := 0
  Else Result := Parent.Level + 1;
end;

Procedure BTreeObject.Assign(Const aObject: BManagedClass);
Var
  aSelf: BManagedClass;
Begin
  Inherited;
  aSelf := BManagedClass(Self);
  IManagedInterface(aSelf).Load(aObject);

  bFirstChild := aObject.FirstChild;
  bLastChild := aObject.LastChild;

  bPrior := aObject.Prior;
  bNext := aObject.Next;
End;

Function BTreeObject.GetFirstChild: BManagedClass;
Begin
  Result := bChildren.LockList.First;
  bChildren.UnlockList;
end;

Function BTreeObject.GetChildren: BManagedList;
Var
  aBuffer: BManagedClass;
Begin
  Result := BManagedList.Build;
  aBuffer := bFirstChild;
  While Not(aBuffer = nil) Do
    Begin
      Result.Add(aBuffer);
      aBuffer := aBuffer.Next;
    End;
end;

Function BTreeObject.GetLastChild: BManagedClass;
Begin
  Result := bChildren.LockList.Last;
  bChildren.UnlockList;
End;

End.
